MODULE Check;

IMPORT
	AES, appl, BufInOut, form, GEMDOS, graf, Oscan, Streams, SysVar, System,
	TOS, v, XBIOS;
FROM BufInOut IMPORT WriteString, WriteLn;
FROM SYSTEM IMPORT ADDRESS, STORE, CODE;

CONST
	nl = 15C+12C;

TYPE
	tpOS = POINTER TO RECORD
		w, version: SHORTCARD;
		preset,pos,pend,rsvd,osmagic: ADDRESS;
		date: LONGCARD;
		conf: SHORTINT;
	END;
	tpSI = POINTER TO SHORTINT;
	tpAdr = POINTER TO ADDRESS;

	tpCookie = POINTER TO tCookie;
	tCookie = RECORD
		id : LONGCARD;
		val: LONGCARD;
	END;
	tCookieId = RECORD
		CASE :SHORTINT OF
		| 0: name: ARRAY [0..5] OF CHAR;
		| 1: id: LONGCARD; null: SHORTINT;
		END
	END;
	
VAR
	h: Streams.tStreamHandle;
	pOS: tpOS;
	p: ADDRESS;
	in: ARRAY[0..10] OF SHORTINT;
	out: ARRAY[0..56] OF SHORTINT;
	vdihdl: SHORTINT;
	oscan: SHORTINT;
	pc: tpCookie;
	CookieId: tCookieId;
	i: SHORTINT;
	GEMDOS_Version: GEMDOS.tVersion;
	s: ARRAY [0..999] OF CHAR;

(* $P+ $X- $Y- *)
PROCEDURE fpu (): SHORTINT;

	BEGIN
		CODE (0487AH, 0001AH);
		CODE (03F3CH, 00026H);
		CODE (04E4EH);
		CODE (05C4FH);
		CODE (07000H);
		CODE (0103AH, 0001EH);
		CODE (00C00H, 00018H);
		CODE (057C0H);
		CODE (05200H);
		CODE (04E75H);
		CODE (0F280H, 00000H);
		CODE (0F327H);
		CODE (041FAH, 0000AH);
		CODE (010AFH, 00001H);
		CODE (0F35FH);
		CODE (04E75H);
		CODE (00000H);
	END fpu;
(* $P= $X= $Y= *)

PROCEDURE WriteEnv;

	VAR
		(*$Reg*) pChar: POINTER TO CHAR;

	BEGIN
		pChar := TOS.BasePage^.Environment;
		REPEAT
			WriteString ('  ');
			WHILE pChar^ # 0C DO
				Streams.Write (pChar^); INC (pChar)
			END;
			WriteLn; INC (pChar)
		UNTIL pChar^ = 0C;
		WriteLn;
	END WriteEnv;

BEGIN
	IF appl.init () >= 0 THEN
		h := Streams.Open ('CHECK.TXT', Streams.WriteOnly, 10000);
		IF h < 0 THEN
			VOID (form.alert (1, '[3][Schreibfehler][Abbruch]'));
		ELSE
			pOS := ADDRESS(SysVar.getSysLong (4F2H));
			GEMDOS_Version := GEMDOS.Sversion ();
			s := FORM (
				'TOS ', pOS^.version:4:16:'0', ' ', pOS^.date:8:16:'0',
				' ', pOS^.conf:4:16:'0', nl,
				'GEMDOS ', GEMDOS_Version.HauptRevision::16, '.',
							  GEMDOS_Version.UnterRevision::16, nl,
				'AES ', AES.global.version:4:16:'0', nl,
				'Getrez ', XBIOS.Getrez (), nl,
				'PhysTop: ', SysVar.getSysLong (042EH):8:16:'0', nl,
				'Logbase: ', LONGINT(XBIOS.Logbase ()):8:16:'0', nl,
				'CPU: 680', ORD (System.CPU), '0' + nl
			);
			WriteString (s);

			CASE System.FPU OF
			| System.None:
				s := 'keine FPU' + nl;
			| System.Atari:
				s := 'Atari-FPU' + nl;
			| System.FLine:
				s := FORM ('FLine-FPU (6888', fpu () + 1, ')' + nl)
			END;
			WriteString (s);

			CODE (0A000H);
			STORE (0, p);
			s := FORM (
				'LineA: ', nl,
				'  BPL: ', tpSI(p+2)^, nl,
				'  Planes: ', tpSI(p)^, nl,
				'  Width: ', tpSI(p-12)^, nl,
				'  Height: ', tpSI(p-4)^, nl
			);
			WriteString (s);

			FOR i:=0 TO 9 DO in[i]:=1 END; in[10]:=2;
			vdihdl := graf.handle (i, i, i, i);
			v.opnvwk (in, vdihdl, out);
			s := FORM (
				'VDI: ', nl,
				'  Width: ', out[0], nl,
				'  Height: ', out[1], nl,
				'  Colors: ', out[13], nl
			);
			WriteString (s);
			v.clsvwk(vdihdl);

			oscan := Oscan.is ();
			s := FORM ('Overscan: ', oscan:4:16:'0', nl);
			WriteString (s);
			IF oscan # 4200 THEN
				WITH Oscan.tab (-1)^ DO
					s := FORM (
						'  BPL: ', BytesPerLine, nl,
						'  Width: ', Width, nl,
						'  Height: ', Height, nl,
						'  LengthOfScreen: ', LengthOfScreen, nl,
						'  PhysbaseOffset: ', PhysbaseOffset, nl,
						'  LogbaseOffset: ', LogbaseOffset, nl
					);
					WriteString (s);
				END
			END;

			pc := ADDRESS(SysVar.getSysLong(5A0H));
			IF pc#NIL THEN
				CookieId.null := 0;
				WriteString ('Cookies:' + nl);
				WHILE pc^.id#0 DO
					CookieId.id := pc^.id;
					s := FORM ('  ', CookieId.name, ' (', pc^.id:8:16:'0', ') = ',
								  pc^.val:8:16:'0', ' ', pc^.val, nl);
					WriteString (s);
					INC (pc);
				END
			END;

			WriteString ('Environment:' + nl);
			WriteEnv;

			Streams.Close (h);
		END;
		appl.exit;
	END
END Check.
			
	
	